home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Extra Heft 12
/
Extra Heft12.bin
/
input64
/
05_86.d64
/
macros .lsp
< prev
next >
Wrap
Text File
|
1995-08-17
|
3KB
|
99 lines
(EXPAND EXPR (LAMBDA NIL (SETQ
MACRO-EXPANSION T)))
(NO-EXPAND EXPR (LAMBDA NIL (SETQ
MACRO-EXPANSION NIL)))
(MACRO-EXPANSION VALUE T)
(FOR MACRO (NLAMBDA L (REPLACE L (
PROG (VAR VON NACH COUNT-FN TEST-FN) (
SETQ VAR (CADR L)) (SETQ VON (EVAL (
CAR (CDDR L)))) (SETQ NACH (EVAL (
CADR (CDDR L)))) (COND ((GREATERP VON
NACH) (SETQ TEST-FN (QUOTE LESSP)) (
SETQ COUNT-FN (QUOTE SUB1))) (T (SETQ
TEST-FN (QUOTE GREATERP)) (SETQ
COUNT-FN (QUOTE ADD1)))) (RETURN (
LIST (QUOTE PROG) (LIST VAR) (LIST (
QUOTE SETQ) VAR VON) (QUOTE LOOP) (
LIST (QUOTE COND) (LIST (LIST TEST-FN
VAR NACH) (QUOTE (RETURN NIL))) (CONS
(QUOTE T) (CDDR (CDDR L)))) (LIST (
QUOTE SETQ) VAR (LIST COUNT-FN VAR)) (
QUOTE (GO LOOP))))))))
(SELECTQ MACRO (NLAMBDA L (REPLACE L (
CONS (QUOTE COND) ((LABEL SELECTQ1 (
LAMBDA (X L) (COND ((ATOM (CDR L)) (
LIST (LIST (QUOTE T) (CAR L)))) (T (
CONS (CONS (LIST (COND ((ATOM (CAAR L)
) (QUOTE EQ)) (T (QUOTE MEMBER))) X (
LIST (QUOTE QUOTE) (CAAR L))) (CDAR L)
) (SELECTQ1 X (CDR L))))))) (CADR L) (
CDDR L))))))
(REPLACE EXPR (LAMBDA (X Y) (COND (
MACRO-EXPANSION (RPLACA X (CAR Y)) (
RPLACD X (CDR Y))) (T Y))))
(IF MACRO (MLAMBDA L (REPLACE L (LIST
(QUOTE COND) (LIST (CADR L) (CAR (
CDDR L))) (CONS (QUOTE T) (CDR (CDDR
L)))))))
(WHILE MACRO (MLAMBDA L (REPLACE L (
LIST (QUOTE PROG) NIL (QUOTE LOOP) (
LIST (QUOTE COND) (LIST (LIST (QUOTE
NOT) (CADR L)) (LIST (QUOTE RETURN)
NIL)) (CONS (QUOTE T) (CDDR L))) (
QUOTE (GO LOOP))))))
(REPEAT MACRO (MLAMBDA L (REPLACE L (
LIST (QUOTE PROG) (QUOTE (N)) (LIST (
QUOTE SETQ) (QUOTE N) (EVAL (CADR L)))
(QUOTE LOOP) (LIST (QUOTE COND) (
LIST (QUOTE (ZEROP N)) (QUOTE (RETURN
NIL))) (CONS (QUOTE T) (CDDR L))) (
QUOTE (SETQ N (SUB1 N))) (QUOTE (GO
LOOP))))))
(LET MACRO (MLAMBDA L (REPLACE L (
CONS (CONS (QUOTE LAMBDA) (CONS (
MAPCAR (QUOTE CAR) (CADR L)) (CDDR L))
) (MAPCAR (QUOTE CADR) (CADR L))))))
(LOCAL MACRO (MLAMBDA L (REPLACE L (
CONS (CONS (QUOTE LAMBDA) (CDR L))
NIL))))
(INCR MACRO (MLAMBDA L (REPLACE L (
LIST (QUOTE SETQ) (CADR L) (LIST (
QUOTE ADD1) (CADR L))))))
(DECR MACRO (MLAMBDA L (REPLACE L (
LIST (QUOTE SETQ) (CADR L) (LIST (
QUOTE SUB1) (CADR L))))))
(PUSH MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE SETQ) (CADR L) (LIST (
QUOTE CONS) (CAR (CDDR L)) (CADR L))))
))
(POP MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE PROG1) (LIST (QUOTE CAR) (
CADR L)) (LIST (QUOTE SETQ) (CADR L) (
LIST (QUOTE CDR) (CADR L)))))))
(MCONS MACRO (NLAMBDA L (REPLACE L (
COND ((ATOM (CDDR L)) (CADR L)) (T (
LIST (QUOTE CONS) (CADR L) (CONS (
QUOTE MCONS) (CDDR L))))))))
(NCONS MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE CONS) (CADR L) NIL))))
(XCONS MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE CONS) (CAR (CDDR L)) (
CADR L)))))
(FUNCTION MACRO (NLAMBDA L (REPLACE L
(LIST (QUOTE QUOTE) (CADR L)))))
(F:L MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE QUOTE) (CONS (QUOTE
LAMBDA) (CDR L))))))
(Q:L MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE QUOTE) (CONS (QUOTE
LAMBDA) (CDR L))))))
(NEQ MACRO (NLAMBDA L (REPLACE L (
LIST (QUOTE NOT) (LIST (QUOTE EQ) (
CADR L) (CAR (CDDR L)))))))
(MACROS VALUE (EXPAND NO-EXPAND
MACRO-EXPANSION FOR SELECTQ REPLACE
IF WHILE REPEAT LET LOCAL INCR DECR
PUSH POP MCONS NCONS XCONS FUNCTION
F:L Q:L NEQ MACROS))
NIL